home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / text.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  40.6 KB  |  1,251 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test the code in the file tkText.c.
  2. # This file is organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1992-1994 The Regents of the University of California.
  5. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # SCCS: @(#) text.test 1.45 97/07/31 10:10:38
  11.  
  12. if {[string compare test [info procs test]] == 1} then \
  13.   {source defs}
  14.  
  15. eval destroy [winfo child .]
  16.  
  17. # Create entries in the option database to be sure that geometry options
  18. # like border width have predictable values.
  19.  
  20. option add *Text.borderWidth 2
  21. option add *Text.highlightThickness 2
  22. option add *Text.font {Courier -12}
  23.  
  24. text .t -width 20 -height 10
  25. pack append . .t {top expand fill}
  26. update
  27. .t debug on
  28. wm geometry . {}
  29.  
  30. # The statements below reset the main window;  it's needed if the window
  31. # manager is mwm to make mwm forget about a previous minimum size setting.
  32.  
  33. wm withdraw .
  34. wm minsize . 1 1
  35. wm positionfrom . user
  36. wm deiconify .
  37.  
  38. entry .t.e
  39. .t.e insert end abcdefg
  40. .t.e select from 0
  41.  
  42. .t insert 1.0 "Line 1
  43. abcdefghijklm
  44. 12345
  45. Line 4
  46. bOy GIrl .#@? x_yz
  47. !@#$%
  48. Line 7"
  49.  
  50. catch {destroy .t2}
  51. text .t2
  52. set i 0
  53. foreach test {
  54.     {-background #ff00ff #ff00ff <gorp>}
  55.     {-bd 4 4 foo}
  56.     {-bg blue blue #xx}
  57.     {-borderwidth 7 7 ++}
  58.     {-cursor watch watch lousy}
  59.     {-exportselection no 0 maybe}
  60.     {-fg red red stupid}
  61.     {-font fixed fixed {}}
  62.     {-foreground #012 #012 bogus}
  63.     {-height 5 5 bad}
  64.     {-highlightbackground #123 #123 bogus}
  65.     {-highlightcolor #234 #234 bogus}
  66.     {-highlightthickness -2 0 bad}
  67.     {-insertbackground green green <bogus>}
  68.     {-insertborderwidth 45 45 bogus}
  69.     {-insertofftime 100 100 2.4}
  70.     {-insertontime 47 47 e1}
  71.     {-insertwidth 2.3 2 47d}
  72.     {-padx 3.4 3 2.4.}
  73.     {-pady 82 82 bogus}
  74.     {-relief raised raised bumpy}
  75.     {-selectbackground #ffff01234567 #ffff01234567 bogus}
  76.     {-selectborderwidth 21 21 3x}
  77.     {-selectforeground yellow yellow #12345}
  78.     {-spacing1 20 20 1.3x}
  79.     {-spacing1 -5 0 bogus}
  80.     {-spacing2 5 5 bogus}
  81.     {-spacing2 -1 0 bogus}
  82.     {-spacing3 20 20 bogus}
  83.     {-spacing3 -10 0 bogus}
  84.     {-state disabled disabled foo}
  85.     {-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs}
  86.     {-width 73 73 2.4}
  87.     {-wrap word word bad_wrap}
  88. } {
  89.     test text-1.[incr i] {text options} {
  90.     set result {}
  91.     lappend result [catch {.t2 configure [lindex $test 0] [lindex $test 3]}]
  92.     .t2 configure [lindex $test 0] [lindex $test 1]
  93.     lappend result [.t2 cget [lindex $test 0]]
  94.     } [list 1 [lindex $test 2]]
  95. }
  96. test text-1.[incr i] {text options} {
  97.     .t2 configure -takefocus "any old thing"
  98.     .t2 cget -takefocus
  99. } {any old thing}
  100. test text-1.[incr i] {text options} {
  101.     .t2 configure -xscrollcommand "x scroll command"
  102.     .t2 configure -xscrollcommand
  103. } {-xscrollcommand xScrollCommand ScrollCommand {} {x scroll command}}
  104. test text-1.[incr i] {text options} {
  105.     .t2 configure -yscrollcommand "test command"
  106.     .t2 configure -yscrollcommand
  107. } {-yscrollcommand yScrollCommand ScrollCommand {} {test command}}
  108. test text-1.[incr i] {text options} {
  109.     set result {}
  110.     foreach i [.t2 configure] {
  111.     lappend result [lindex $i 4]
  112.     }
  113.     set result
  114. } {blue {} {} 7 watch 0 {} fixed #012 5 #123 #234 0 green 45 100 47 2 3 82 raised #ffff01234567 21 yellow 0 0 0 0 disabled {1i 2i 3i 4i} {any old thing} 73 word {x scroll command} {test command}}
  115.  
  116. test text-2.1 {Tk_TextCmd procedure} {
  117.     list [catch {text} msg] $msg
  118. } {1 {wrong # args: should be "text pathName ?options?"}}
  119. test text-2.2 {Tk_TextCmd procedure} {
  120.     list [catch {text foobar} msg] $msg
  121. } {1 {bad window path name "foobar"}}
  122. test text-2.3 {Tk_TextCmd procedure} {
  123.     catch {destroy .t2}
  124.     list [catch {text .t2 -gorp nofun} msg] $msg [winfo exists .t2]
  125. } {1 {unknown option "-gorp"} 0}
  126. test text-2.4 {Tk_TextCmd procedure} {
  127.     catch {destroy .t2}
  128.     list [catch {text .t2 -bd 2 -fg red} msg] $msg \
  129.     [lindex [.t2 config -bd] 4] [lindex [.t2 config -fg] 4]
  130. } {0 .t2 2 red}
  131. if {$tcl_platform(platform) == "macintosh"} {
  132.     set relief solid
  133. } elseif {$tcl_platform(platform) == "windows"} {
  134.     set relief flat
  135. } else {
  136.     set relief raised
  137. }
  138. test text-2.5 {Tk_TextCmd procedure} {
  139.     catch {destroy .t2}
  140.     text .t2
  141.     .t2 tag cget sel -relief 
  142. } $relief
  143. test text-2.6 {Tk_TextCmd procedure} {
  144.     catch {destroy .t2}
  145.     list [text .t2] [winfo class .t2]
  146. } {.t2 Text}
  147.  
  148. test text-3.1 {TextWidgetCmd procedure, basics} {
  149.     list [catch {.t} msg] $msg
  150. } {1 {wrong # args: should be ".t option ?arg arg ...?"}}
  151. test text-3.2 {TextWidgetCmd procedure} {
  152.     list [catch {.t gorp 1.0 z 1.2} msg] $msg
  153. } {1 {bad option "gorp": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
  154.  
  155. test text-4.1 {TextWidgetCmd procedure, "bbox" option} {
  156.     list [catch {.t bbox} msg] $msg
  157. } {1 {wrong # args: should be ".t bbox index"}}
  158. test text-4.2 {TextWidgetCmd procedure, "bbox" option} {
  159.     list [catch {.t bbox a b} msg] $msg
  160. } {1 {wrong # args: should be ".t bbox index"}}
  161. test text-4.3 {TextWidgetCmd procedure, "bbox" option} {
  162.     list [catch {.t bbox bad_mark} msg] $msg
  163. } {1 {bad text index "bad_mark"}}
  164.  
  165. test text-5.1 {TextWidgetCmd procedure, "cget" option} {
  166.     list [catch {.t cget} msg] $msg
  167. } {1 {wrong # args: should be ".t cget option"}}
  168. test text-5.2 {TextWidgetCmd procedure, "cget" option} {
  169.     list [catch {.t cget a b} msg] $msg
  170. } {1 {wrong # args: should be ".t cget option"}}
  171. test text-5.3 {TextWidgetCmd procedure, "cget" option} {
  172.     list [catch {.t cget -gorp} msg] $msg
  173. } {1 {unknown option "-gorp"}}
  174. test text-5.4 {TextWidgetCmd procedure, "cget" option} {
  175.     .t configure -bd 17
  176.     .t cget -bd
  177. } {17}
  178. .t configure -bd [lindex [.t configure -bd] 3]
  179.  
  180. test text-6.1 {TextWidgetCmd procedure, "compare" option} {
  181.     list [catch {.t compare a b} msg] $msg
  182. } {1 {wrong # args: should be ".t compare index1 op index2"}}
  183. test text-6.2 {TextWidgetCmd procedure, "compare" option} {
  184.     list [catch {.t compare a b c d} msg] $msg
  185. } {1 {wrong # args: should be ".t compare index1 op index2"}}
  186. test text-6.3 {TextWidgetCmd procedure, "compare" option} {
  187.     list [catch {.t compare @x == 1.0} msg] $msg
  188. } {1 {bad text index "@x"}}
  189. test text-6.4 {TextWidgetCmd procedure, "compare" option} {
  190.     list [catch {.t compare 1.0 < @y} msg] $msg
  191. } {1 {bad text index "@y"}}
  192. test text-6.5 {TextWidgetCmd procedure, "compare" option} {
  193.     list [.t compare 1.1 < 1.0] [.t compare 1.1 < 1.1] [.t compare 1.1 < 1.2]
  194. } {0 0 1}
  195. test text-6.6 {TextWidgetCmd procedure, "compare" option} {
  196.     list [.t compare 1.1 <= 1.0] [.t compare 1.1 <= 1.1] [.t compare 1.1 <= 1.2]
  197. } {0 1 1}
  198. test text-6.7 {TextWidgetCmd procedure, "compare" option} {
  199.     list [.t compare 1.1 == 1.0] [.t compare 1.1 == 1.1] [.t compare 1.1 == 1.2]
  200. } {0 1 0}
  201. test text-6.8 {TextWidgetCmd procedure, "compare" option} {
  202.     list [.t compare 1.1 >= 1.0] [.t compare 1.1 >= 1.1] [.t compare 1.1 >= 1.2]
  203. } {1 1 0}
  204. test text-6.9 {TextWidgetCmd procedure, "compare" option} {
  205.     list [.t compare 1.1 > 1.0] [.t compare 1.1 > 1.1] [.t compare 1.1 > 1.2]
  206. } {1 0 0}
  207. test text-6.10 {TextWidgetCmd procedure, "compare" option} {
  208.     list [.t com 1.1 != 1.0] [.t compare 1.1 != 1.1] [.t compare 1.1 != 1.2]
  209. } {1 0 1}
  210. test text-6.11 {TextWidgetCmd procedure, "compare" option} {
  211.     list [catch {.t compare 1.0 <x 1.2} msg] $msg
  212. } {1 {bad comparison operator "<x": must be <, <=, ==, >=, >, or !=}}
  213. test text-6.12 {TextWidgetCmd procedure, "compare" option} {
  214.     list [catch {.t compare 1.0 >> 1.2} msg] $msg
  215. } {1 {bad comparison operator ">>": must be <, <=, ==, >=, >, or !=}}
  216. test text-6.13 {TextWidgetCmd procedure, "compare" option} {
  217.     list [catch {.t compare 1.0 z 1.2} msg] $msg
  218. } {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}}
  219. test text-6.14 {TextWidgetCmd procedure, "compare" option} {
  220.     list [catch {.t co 1.0 z 1.2} msg] $msg
  221. } {1 {bad option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
  222.  
  223. # "configure" option is already covered above
  224.  
  225. test text-7.1 {TextWidgetCmd procedure, "debug" option} {
  226.     list [catch {.t debug 0 1} msg] $msg
  227. } {1 {wrong # args: should be ".t debug boolean"}}
  228. test text-7.2 {TextWidgetCmd procedure, "debug" option} {
  229.     list [catch {.t de 0 1} msg] $msg
  230. } {1 {bad option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
  231. test text-7.3 {TextWidgetCmd procedure, "debug" option} {
  232.     .t debug true
  233.     .t deb
  234. } 1
  235. test text-7.4 {TextWidgetCmd procedure, "debug" option} {
  236.     .t debug false
  237.     .t debug
  238. } 0
  239. .t debug
  240.  
  241. test text-8.1 {TextWidgetCmd procedure, "delete" option} {
  242.     list [catch {.t delete} msg] $msg
  243. } {1 {wrong # args: should be ".t delete index1 ?index2?"}}
  244. test text-8.2 {TextWidgetCmd procedure, "delete" option} {
  245.     list [catch {.t delete a b c} msg] $msg
  246. } {1 {wrong # args: should be ".t delete index1 ?index2?"}}
  247. test text-8.3 {TextWidgetCmd procedure, "delete" option} {
  248.     list [catch {.t delete @x 2.2} msg] $msg
  249. } {1 {bad text index "@x"}}
  250. test text-8.4 {TextWidgetCmd procedure, "delete" option} {
  251.     list [catch {.t delete 2.3 @y} msg] $msg
  252. } {1 {bad text index "@y"}}
  253. test text-8.5 {TextWidgetCmd procedure, "delete" option} {
  254.     .t con -state disabled
  255.     .t delete 2.3
  256.     .t g 2.0 2.end
  257. } abcdefghijklm
  258. .t con -state normal
  259. test text-8.6 {TextWidgetCmd procedure, "delete" option} {
  260.     .t delete 2.3
  261.     .t get 2.0 2.end
  262. } abcefghijklm
  263. test text-8.7 {TextWidgetCmd procedure, "delete" option} {
  264.     .t delete 2.1 2.3
  265.     .t get 2.0 2.end
  266. } aefghijklm
  267.  
  268. test text-9.1 {TextWidgetCmd procedure, "get" option} {
  269.     list [catch {.t get} msg] $msg
  270. } {1 {wrong # args: should be ".t get index1 ?index2?"}}
  271. test text-9.2 {TextWidgetCmd procedure, "get" option} {
  272.     list [catch {.t get a b c} msg] $msg
  273. } {1 {wrong # args: should be ".t get index1 ?index2?"}}
  274. test text-9.3 {TextWidgetCmd procedure, "get" option} {
  275.     list [catch {.t get @q 3.1} msg] $msg
  276. } {1 {bad text index "@q"}}
  277. test text-9.4 {TextWidgetCmd procedure, "get" option} {
  278.     list [catch {.t get 3.1 @r} msg] $msg
  279. } {1 {bad text index "@r"}}
  280. test text-9.5 {TextWidgetCmd procedure, "get" option} {
  281.     .t get 5.7 5.3
  282. } {}
  283. test text-9.6 {TextWidgetCmd procedure, "get" option} {
  284.     .t get 5.3 5.5
  285. } { G}
  286. test text-9.7 {TextWidgetCmd procedure, "get" option} {
  287.     .t get 5.3 end
  288. } { GIrl .#@? x_yz
  289. !@#$%
  290. Line 7
  291. }
  292. .t mark set a 5.3
  293. .t mark set b 5.3
  294. .t mark set c 5.5
  295. test text-9.8 {TextWidgetCmd procedure, "get" option} {
  296.     .t get 5.2 5.7
  297. } {y GIr}
  298. test text-9.9 {TextWidgetCmd procedure, "get" option} {
  299.     .t get 5.2
  300. } {y}
  301. test text-9.10 {TextWidgetCmd procedure, "get" option} {
  302.     .t get 5.2 5.4
  303. } {y }
  304.  
  305. test text-10.1 {TextWidgetCmd procedure, "index" option} {
  306.     list [catch {.t index} msg] $msg
  307. } {1 {wrong # args: should be ".t index index"}}
  308. test text-10.2 {TextWidgetCmd procedure, "index" option} {
  309.     list [catch {.t ind a b} msg] $msg
  310. } {1 {wrong # args: should be ".t index index"}}
  311. test text-10.3 {TextWidgetCmd procedure, "index" option} {
  312.     list [catch {.t in a b} msg] $msg
  313. } {1 {bad option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
  314. test text-10.4 {TextWidgetCmd procedure, "index" option} {
  315.     list [catch {.t index @xyz} msg] $msg
  316. } {1 {bad text index "@xyz"}}
  317. test text-10.5 {TextWidgetCmd procedure, "index" option} {
  318.     .t index 1.2
  319. } 1.2
  320.  
  321. test text-11.1 {TextWidgetCmd procedure, "insert" option} {
  322.     list [catch {.t insert 1.2} msg] $msg
  323. } {1 {wrong # args: should be ".t insert index chars ?tagList chars tagList ...?"}}
  324. test text-11.2 {TextWidgetCmd procedure, "insert" option} {
  325.     .t config -state disabled
  326.     .t insert 1.2 xyzzy
  327.     .t get 1.0 1.end
  328. } {Line 1}
  329. .t config -state normal
  330. test text-11.3 {TextWidgetCmd procedure, "insert" option} {
  331.     .t insert 1.2 xyzzy
  332.     .t get 1.0 1.end
  333. } {Lixyzzyne 1}
  334. test text-11.4 {TextWidgetCmd procedure, "insert" option} {
  335.     .t delete 1.0 end
  336.     .t insert 1.0 "Sample text" x
  337.     .t tag ranges x
  338. } {1.0 1.11}
  339. test text-11.5 {TextWidgetCmd procedure, "insert" option} {
  340.     .t delete 1.0 end
  341.     .t insert 1.0 "Sample text" x
  342.     .t insert 1.2 "XYZ" y
  343.     list [.t tag ranges x] [.t tag ranges y]
  344. } {{1.0 1.2 1.5 1.14} {1.2 1.5}}
  345. test text-11.6 {TextWidgetCmd procedure, "insert" option} {
  346.     .t delete 1.0 end
  347.     .t insert 1.0 "Sample text" {x y z}
  348.     list [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
  349. } {{1.0 1.11} {1.0 1.11} {1.0 1.11}}
  350. test text-11.7 {TextWidgetCmd procedure, "insert" option} {
  351.     .t delete 1.0 end
  352.     .t insert 1.0 "Sample text" {x y z}
  353.     .t insert 1.3 "A" {a b z}
  354.     list [.t tag ranges a] [.t tag ranges b] [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
  355. } {{1.3 1.4} {1.3 1.4} {1.0 1.3 1.4 1.12} {1.0 1.3 1.4 1.12} {1.0 1.12}}
  356. test text-11.8 {TextWidgetCmd procedure, "insert" option} {
  357.     .t delete 1.0 end
  358.     list [catch {.t insert 1.0 "Sample text" "a \{b"} msg] $msg
  359. } {1 {unmatched open brace in list}}
  360. test text-11.9 {TextWidgetCmd procedure, "insert" option} {
  361.     .t delete 1.0 end
  362.     .t insert 1.0 "First" bold " " {} second "x y z" " third"
  363.     list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges x] \
  364.         [.t tag ranges y] [.t tag ranges z]
  365. } {{First second third} {1.0 1.5} {1.6 1.12} {1.6 1.12} {1.6 1.12}}
  366. test text-11.10 {TextWidgetCmd procedure, "insert" option} {
  367.     .t delete 1.0 end
  368.     .t insert 1.0 "First" bold " second" silly
  369.     list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly]
  370. } {{First second} {1.0 1.5} {1.5 1.12}}
  371.  
  372. # Mark, scan, search, see, tag, window, xview, and yview actions are tested elsewhere.
  373.  
  374. test text-12.1 {ConfigureText procedure} {
  375.     list [catch {.t2 configure -state foobar} msg] $msg
  376. } {1 {bad state value "foobar": must be normal or disabled}}
  377. test text-12.2 {ConfigureText procedure} {
  378.     .t2 configure -spacing1 -2 -spacing2 1 -spacing3 1
  379.     list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
  380. } {0 1 1}
  381. test text-12.3 {ConfigureText procedure} {
  382.     .t2 configure -spacing1 1 -spacing2 -1 -spacing3 1
  383.     list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
  384. } {1 0 1}
  385. test text-12.4 {ConfigureText procedure} {
  386.     .t2 configure -spacing1 1 -spacing2 1 -spacing3 -3
  387.     list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
  388. } {1 1 0}
  389. test text-12.5 {ConfigureText procedure} {
  390.     set x [list [catch {.t2 configure -tabs {30 foo}} msg] $msg $errorInfo]
  391.     .t2 configure -tabs {10 20 30}
  392.     set x
  393. } {1 {bad tab alignment "foo": must be left, right, center, or numeric} {bad tab alignment "foo": must be left, right, center, or numeric
  394.     (while processing -tabs option)
  395.     invoked from within
  396. ".t2 configure -tabs {30 foo}"}}
  397. test text-12.6 {ConfigureText procedure} {
  398.     .t2 configure -tabs {10 20 30}
  399.     .t2 configure -tabs {}
  400.     .t2 cget -tabs
  401. } {}
  402. test text-12.7 {ConfigureText procedure} {
  403.     list [catch {.t2 configure -wrap bogus} msg] $msg
  404. } {1 {bad wrap mode "bogus": must be char, none, or word}}
  405. test text-12.8 {ConfigureText procedure} {
  406.     .t2 configure -selectborderwidth 17 -selectforeground #332211 \
  407.         -selectbackground #abc
  408.     list [lindex [.t2 tag config sel -borderwidth] 4] \
  409.     [lindex [.t2 tag config sel -foreground] 4] \
  410.     [lindex [.t2 tag config sel -background] 4]
  411. } {17 #332211 #abc}
  412. test text-12.9 {ConfigureText procedure} {
  413.     .t2 configure -selectborderwidth {}
  414.     .t2 tag cget sel -borderwidth
  415. } {}
  416. test text-12.10 {ConfigureText procedure} {
  417.     list [catch {.t2 configure -selectborderwidth foo} msg] $msg
  418. } {1 {bad screen distance "foo"}}
  419. test text-12.11 {ConfigureText procedure} {
  420.     catch {destroy .t2}
  421.     .t.e select to 2
  422.     text .t2 -exportselection 1
  423.     selection get
  424. } {ab}
  425. test text-12.12 {ConfigureText procedure} {
  426.     catch {destroy .t2}
  427.     .t.e select to 2
  428.     text .t2 -exportselection 0
  429.     .t2 insert insert 1234657890
  430.     .t2 tag add sel 1.0 1.4
  431.     selection get
  432. } {ab}
  433. test text-12.13 {ConfigureText procedure} {
  434.     catch {destroy .t2}
  435.     .t.e select to 1
  436.     text .t2 -exportselection 1
  437.     .t2 insert insert 1234657890
  438.     .t2 tag add sel 1.0 1.4
  439.     selection get
  440. } {1234}
  441. test text-12.14 {ConfigureText procedure} {
  442.     catch {destroy .t2}
  443.     .t.e select to 1
  444.     text .t2 -exportselection 0
  445.     .t2 insert insert 1234657890
  446.     .t2 tag add sel 1.0 1.4
  447.     .t2 configure -exportselection 1
  448.     selection get
  449. } {1234}
  450. test text-12.15 {ConfigureText procedure} {
  451.     catch {destroy .t2}
  452.     text .t2 -exportselection 1
  453.     .t2 insert insert 1234657890
  454.     .t2 tag add sel 1.0 1.4
  455.     set result [selection get]
  456.     .t2 configure -exportselection 0
  457.     lappend result [catch {selection get} msg] $msg
  458. } {1234 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
  459. test text-12.16 {ConfigureText procedure} {fonts} {
  460.     # This test is non-portable because the window size will vary depending
  461.     # on the font size, which can vary.
  462.  
  463.     catch {destroy .t2}
  464.     toplevel .t2
  465.     text .t2.t -width 20 -height 10
  466.     pack append .t2 .t2.t top
  467.     wm geometry .t2 +0+0
  468.     update
  469.     wm geometry .t2
  470. } {150x140+0+0}
  471. test text-12.17 {ConfigureText procedure} {
  472.     # This test was failing Windows because the title bar on .t2
  473.     # was a certain minimum size and it was interfering with the size
  474.     # requested by the -setgrid.  The "overrideredirect" gets rid of the
  475.     # titlebar so the toplevel can shrink to the appropriate size.
  476.  
  477.     catch {destroy .t2}
  478.     toplevel .t2
  479.     wm overrideredirect .t2 1
  480.     text .t2.t -width 20 -height 10 -setgrid 1
  481.     pack append .t2 .t2.t top
  482.     wm geometry .t2 +0+0
  483.     update
  484.     wm geometry .t2
  485. } {20x10+0+0}
  486. test text-12.18 {ConfigureText procedure} {
  487.     # This test was failing on Windows because the title bar on .t2
  488.     # was a certain minimum size and it was interfering with the size
  489.     # requested by the -setgrid.  The "overrideredirect" gets rid of the
  490.     # titlebar so the toplevel can shrink to the appropriate size.
  491.  
  492.     catch {destroy .t2}
  493.     toplevel .t2
  494.     wm overrideredirect .t2 1
  495.     text .t2.t -width 20 -height 10 -setgrid 1
  496.     pack append .t2 .t2.t top
  497.     wm geometry .t2 +0+0
  498.     update
  499.     set result [wm geometry .t2]
  500.     wm geometry .t2 15x8
  501.     update
  502.     lappend result [wm geometry .t2]
  503.     .t2.t configure -wrap word
  504.     update
  505.     lappend result [wm geometry .t2]
  506. } {20x10+0+0 15x8+0+0 15x8+0+0}
  507.  
  508. test text-13.1 {TextWorldChanged procedure, spacing options} fonts {
  509.     catch {destroy .t2}
  510.     text .t2 -width 20 -height 10
  511.     set result [winfo reqheight .t2]
  512.     .t2 configure -spacing1 2
  513.     lappend result [winfo reqheight .t2]
  514.     .t2  configure -spacing3 1
  515.     lappend result [winfo reqheight .t2]
  516.     .t2 configure -spacing1 0
  517.     lappend result [winfo reqheight .t2]
  518. } {140 160 170 150}
  519.  
  520. test text-14.1 {TextEventProc procedure} {
  521.     text .tx1 -bg #543210
  522.     rename .tx1 .tx2
  523.     set x {}
  524.     lappend x [winfo exists .tx1]
  525.     lappend x [.tx2 cget -bg]
  526.     destroy .tx1
  527.     lappend x [info command .tx*] [winfo exists .tx1] [winfo exists .tx2]
  528. } {1 #543210 {} 0 0}
  529.  
  530. test text-15.1 {TextCmdDeletedProc procedure} {
  531.     text .tx1
  532.     rename .tx1 {}
  533.     list [info command .tx*] [winfo exists .tx1]
  534. } {{} 0}
  535. test text-15.2 {TextCmdDeletedProc procedure, disabling -setgrid} fonts {
  536.     catch {destroy .top}
  537.     toplevel .top
  538.     wm geom .top +0+0
  539.     text .top.t -setgrid 1 -width 20 -height 10
  540.     pack .top.t
  541.     update
  542.     set x [wm geometry .top]
  543.     rename .top.t {}
  544.     update
  545.     lappend x [wm geometry .top]
  546.     destroy .top
  547.     set x
  548. } {20x10+0+0 150x140+0+0}
  549.  
  550. test text-16.1 {InsertChars procedure} {
  551.     catch {destroy .t2}
  552.     text .t2
  553.     .t2 insert 2.0 abcd\n
  554.     .t2 get 1.0 end
  555. } {abcd
  556.  
  557. }
  558. test text-16.2 {InsertChars procedure} {
  559.     catch {destroy .t2}
  560.     text .t2
  561.     .t2 insert 1.0 abcd\n
  562.     .t2 insert end 123\n
  563.     .t2 get 1.0 end
  564. } {abcd
  565. 123
  566.  
  567. }
  568. test text-16.3 {InsertChars procedure} {
  569.     catch {destroy .t2}
  570.     text .t2
  571.     .t2 insert 1.0 abcd\n
  572.     .t2 insert 10.0 123
  573.     .t2 get 1.0 end
  574. } {abcd
  575. 123
  576. }
  577. test text-16.4 {InsertChars procedure, inserting on top visible line} {
  578.     catch {destroy .t2}
  579.     text .t2 -width 20 -height 4 -wrap word
  580.     pack .t2
  581.     .t2 insert insert "Now is the time for all great men to come to the "
  582.     .t2 insert insert "aid of their party.\n"
  583.     .t2 insert insert "Now is the time for all great men.\n"
  584.     .t2 see end
  585.     update
  586.     .t2 insert 1.0 "Short\n"
  587.     .t2 index @0,0
  588. } {2.56}
  589. test text-16.5 {InsertChars procedure, inserting on top visible line} {
  590.     catch {destroy .t2}
  591.     text .t2 -width 20 -height 4 -wrap word
  592.     pack .t2
  593.     .t2 insert insert "Now is the time for all great men to come to the "
  594.     .t2 insert insert "aid of their party.\n"
  595.     .t2 insert insert "Now is the time for all great men.\n"
  596.     .t2 see end
  597.     update
  598.     .t2 insert 1.55 "Short\n"
  599.     .t2 index @0,0
  600. } {2.0}
  601. test text-16.6 {InsertChars procedure, inserting on top visible line} {
  602.     catch {destroy .t2}
  603.     text .t2 -width 20 -height 4 -wrap word
  604.     pack .t2
  605.     .t2 insert insert "Now is the time for all great men to come to the "
  606.     .t2 insert insert "aid of their party.\n"
  607.     .t2 insert insert "Now is the time for all great men.\n"
  608.     .t2 see end
  609.     update
  610.     .t2 insert 1.56 "Short\n"
  611.     .t2 index @0,0
  612. } {1.56}
  613. test text-16.7 {InsertChars procedure, inserting on top visible line} {
  614.     catch {destroy .t2}
  615.     text .t2 -width 20 -height 4 -wrap word
  616.     pack .t2
  617.     .t2 insert insert "Now is the time for all great men to come to the "
  618.     .t2 insert insert "aid of their party.\n"
  619.     .t2 insert insert "Now is the time for all great men.\n"
  620.     .t2 see end
  621.     update
  622.     .t2 insert 1.57 "Short\n"
  623.     .t2 index @0,0
  624. } {1.56}
  625. catch {destroy .t2}
  626.  
  627. proc setup {} {
  628.     .t delete 1.0 end
  629.     .t insert 1.0 "Line 1
  630. abcde
  631. 12345
  632. Line 4"
  633. }
  634.  
  635. .t delete 1.0 end
  636. test text-17.1 {DeleteChars procedure} {
  637.     .t get 1.0 end
  638. } {
  639. }
  640. test text-17.2 {DeleteChars procedure} {
  641.     list [catch {.t delete foobar} msg] $msg
  642. } {1 {bad text index "foobar"}}
  643. test text-17.3 {DeleteChars procedure} {
  644.     list [catch {.t delete 1.0 lousy} msg] $msg
  645. } {1 {bad text index "lousy"}}
  646. test text-17.4 {DeleteChars procedure} {
  647.     setup
  648.     .t delete 2.1
  649.     .t get 1.0 end
  650. } {Line 1
  651. acde
  652. 12345
  653. Line 4
  654. }
  655. test text-17.5 {DeleteChars procedure} {
  656.     setup
  657.     .t delete 2.3
  658.     .t get 1.0 end
  659. } {Line 1
  660. abce
  661. 12345
  662. Line 4
  663. }
  664. test text-17.6 {DeleteChars procedure} {
  665.     setup
  666.     .t delete 2.end
  667.     .t get 1.0 end
  668. } {Line 1
  669. abcde12345
  670. Line 4
  671. }
  672. test text-17.7 {DeleteChars procedure} {
  673.     setup
  674.     .t tag add sel 4.2 end
  675.     .t delete 4.2 end
  676.     list [.t tag ranges sel] [.t get 1.0 end]
  677. } {{} {Line 1
  678. abcde
  679. 12345
  680. Li
  681. }}
  682. test text-17.8 {DeleteChars procedure} {
  683.     setup
  684.     .t tag add sel 1.0 end
  685.     .t delete 4.0 end
  686.     list [.t tag ranges sel] [.t get 1.0 end]
  687. } {{1.0 3.5} {Line 1
  688. abcde
  689. 12345
  690. }}
  691. test text-17.9 {DeleteChars procedure} {
  692.     setup
  693.     .t delete 2.2 2.2
  694.     .t get 1.0 end
  695. } {Line 1
  696. abcde
  697. 12345
  698. Line 4
  699. }
  700. test text-17.10 {DeleteChars procedure} {
  701.     setup
  702.     .t delete 2.3 2.1
  703.     .t get 1.0 end
  704. } {Line 1
  705. abcde
  706. 12345
  707. Line 4
  708. }
  709. test text-17.11 {DeleteChars procedure} {
  710.     catch {destroy .t2}
  711.     toplevel .t2
  712.     text .t2.t -width 20 -height 5
  713.     pack append .t2 .t2.t top
  714.     wm geometry .t2 +0+0
  715.     .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns"
  716.     update
  717.     .t2.t delete 1.0 3.0
  718.     list [.t2.t index @0,0] [.t2.t get @0,0]
  719. } {1.0 x}
  720. test text-17.12 {DeleteChars procedure} {
  721.     catch {destroy .t2}
  722.     toplevel .t2
  723.     text .t2.t -width 20 -height 5
  724.     pack append .t2 .t2.t top
  725.     wm geometry .t2 +0+0
  726.     .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns"
  727.     .t2.t yview 3.0
  728.     update
  729.     .t2.t delete 2.0 4.0
  730.     list [.t2.t index @0,0] [.t2.t get @0,0]
  731. } {2.0 y}
  732. catch {destroy .t2}
  733. toplevel .t2
  734. text .t2.t -width 1 -height 10 -wrap char
  735. frame .t2.f -width 200 -height 20 -relief raised -bd 2
  736. pack .t2.f .t2.t -side left
  737. wm geometry .t2 +0+0
  738. update
  739. test text-17.13 {DeleteChars procedure, updates affecting topIndex} {
  740.     .t2.t delete 1.0 end
  741.     .t2.t insert end "abcde\n12345\nqrstuv"
  742.     .t2.t yview 2.1
  743.     .t2.t delete 1.4 2.3
  744.     .t2.t index @0,0
  745. } {1.2}
  746. test text-17.14 {DeleteChars procedure, updates affecting topIndex} {
  747.     .t2.t delete 1.0 end
  748.     .t2.t insert end "abcde\n12345\nqrstuv"
  749.     .t2.t yview 2.1
  750.     .t2.t delete 2.3 2.4
  751.     .t2.t index @0,0
  752. } {2.0}
  753. test text-17.15 {DeleteChars procedure, updates affecting topIndex} {
  754.     .t2.t delete 1.0 end
  755.     .t2.t insert end "abcde\n12345\nqrstuv"
  756.     .t2.t yview 1.3
  757.     .t2.t delete 1.0 1.2
  758.     .t2.t index @0,0
  759. } {1.1}
  760. test text-17.16 {DeleteChars procedure, updates affecting topIndex} {
  761.     catch {destroy .t2}
  762.     toplevel .t2
  763.     text .t2.t -width 6 -height 10 -wrap word
  764.     frame .t2.f -width 200 -height 20 -relief raised -bd 2
  765.     pack .t2.f .t2.t -side left
  766.     wm geometry .t2 +0+0
  767.     update
  768.     .t2.t insert end "abc def\n01 2345 678 9101112\nLine 3\nLine 4\nLine 5\n6\n7\n8\n"
  769.     .t2.t yview 2.4
  770.     .t2.t delete 2.5
  771.     set x [.t2.t index @0,0]
  772.     .t2.t delete 2.5
  773.     list $x [.t2.t index @0,0]
  774. } {2.3 2.0}
  775.  
  776. .t delete 1.0 end
  777. foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} {
  778.     .t insert end $i.0$i.1$i.2$i.3$i.4\n
  779. }
  780. test text-18.1 {TextFetchSelection procedure} {
  781.     .t tag add sel 1.3 3.4
  782.     selection get
  783. } {a.1a.2a.3a.4
  784. b.0b.1b.2b.3b.4
  785. c.0c}
  786. test text-18.2 {TextFetchSelection procedure} {
  787.     .t tag add x 1.2
  788.     .t tag add x 1.4
  789.     .t tag add x 2.0
  790.     .t tag add x 2.3
  791.     .t tag remove sel 1.0 end
  792.     .t tag add sel 1.0 3.4
  793.     selection get
  794. } {a.0a.1a.2a.3a.4
  795. b.0b.1b.2b.3b.4
  796. c.0c}
  797. test text-18.3 {TextFetchSelection procedure} {
  798.     .t tag remove sel 1.0 end
  799.     .t tag add sel 13.3
  800.     selection get
  801. } {m}
  802. test text-18.4 {TextFetchSelection procedure} {
  803.     .t tag remove x 1.0 end
  804.     .t tag add sel 1.0 3.4
  805.     .t tag remove sel 1.0 end
  806.     .t tag add sel 1.2 1.5
  807.     .t tag add sel 2.4 3.1
  808.     .t tag add sel 10.0 10.end
  809.     .t tag add sel 13.3
  810.     selection get
  811. } {0a..1b.2b.3b.4
  812. cj.0j.1j.2j.3j.4m}
  813. set x ""
  814. for {set i 1} {$i < 200} {incr i} {
  815.     append x "This is line $i, padded to just about 53 characters.\n"
  816. }
  817. test text-18.5 {TextFetchSelection procedure, long selections} {
  818.     .t delete 1.0 end
  819.     .t insert end $x
  820.     .t tag add sel 1.0 end
  821.     selection get
  822. } $x\n
  823.  
  824. test text-19.1 {TkTextLostSelection procedure} {unixOnly} {
  825.     catch {destroy .t2}
  826.     text .t2
  827.     .t2 insert 1.0 "abc\ndef\nghijk\n1234"
  828.     .t2 tag add sel 1.2 3.3
  829.     .t.e select to 1
  830.     .t2 tag ranges sel
  831. } {}
  832. test text-19.2 {TkTextLostSelection procedure} {macOrPc} {
  833.     catch {destroy .t2}
  834.     text .t2
  835.     .t2 insert 1.0 "abc\ndef\nghijk\n1234"
  836.     .t2 tag add sel 1.2 3.3
  837.     .t.e select to 1
  838.     .t2 tag ranges sel
  839. } {1.2 3.3}
  840. catch {destroy .t2}
  841.  
  842. .t delete 1.0 end
  843. .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx"
  844. test text-20.1 {TextSearchCmd procedure, argument parsing} {
  845.     list [catch {.t search -} msg] $msg
  846. } {1 {bad switch "-": must be -forward, -backward, -exact, -regexp, -nocase, -count, or --}}
  847. test text-20.2 {TextSearchCmd procedure, -backwards option} {
  848.     .t search -backwards xyz 1.4
  849. } {1.1}
  850. test text-20.3 {TextSearchCmd procedure, -forwards option} {
  851.     .t search -forwards xyz 1.4
  852. } {1.5}
  853. test text-20.4 {TextSearchCmd procedure, -exact option} {
  854.     .t search -f -exact x. 1.0
  855. } {1.9}
  856. test text-20.5 {TextSearchCmd procedure, -regexp option} {
  857.     .t search -b -regexp x.z 1.4
  858. } {1.1}
  859. test text-20.6 {TextSearchCmd procedure, -count option} {
  860.     set length unmodified
  861.     list [.t search -count length x. 1.4] $length
  862. } {1.9 2}
  863. test text-20.7 {TextSearchCmd procedure, -count option} {
  864.     list [catch {.t search -count} msg] $msg
  865. } {1 {no value given for "-count" option}}
  866. test text-20.8 {TextSearchCmd procedure, -nocase option} {
  867.     list [.t search -nocase BaR 1.1] [.t search BaR 1.1]
  868. } {2.13 2.23}
  869. test text-20.9 {TextSearchCmd procedure, -nocase option} {
  870.     .t search -n BaR 1.1
  871. } {2.13}
  872. test text-20.10 {TextSearchCmd procedure, -- option} {
  873.     .t search -- -forward 1.0
  874. } {2.4}
  875. test text-20.11 {TextSearchCmd procedure, argument parsing} {
  876.     list [catch {.t search abc} msg] $msg
  877. } {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?}}
  878. test text-20.12 {TextSearchCmd procedure, argument parsing} {
  879.     list [catch {.t search abc d e f} msg] $msg
  880. } {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?}}
  881. test text-20.13 {TextSearchCmd procedure, check index} {
  882.     list [catch {.t search abc gorp} msg] $msg
  883. } {1 {bad text index "gorp"}}
  884. test text-20.14 {TextSearchCmd procedure, startIndex == "end"} {
  885.     .t search non-existent end
  886. } {}
  887. test text-20.15 {TextSearchCmd procedure, startIndex == "end"} {
  888.     .t search non-existent end
  889. } {}
  890. test text-20.16 {TextSearchCmd procedure, bad stopIndex} {
  891.     list [catch {.t search abc 1.0 lousy} msg] $msg
  892. } {1 {bad text index "lousy"}}
  893. test text-20.17 {TextSearchCmd procedure, pattern case conversion} {
  894.     list [.t search -nocase BAR 1.1] [.t search BAR 1.1]
  895. } {2.13 {}}
  896. test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} {
  897.     list [catch {.t search -regexp a( 1.0} msg] $msg
  898. } {1 {couldn't compile regular expression pattern: unmatched ()}}
  899. test text-20.19 {TextSearchCmd procedure, skip dummy last line} {
  900.     .t search -backwards BaR end 1.0
  901. } {2.23}
  902. test text-20.20 {TextSearchCmd procedure, skip dummy last line} {
  903.     .t search -backwards \n end 1.0
  904. } {3.9}
  905. test text-20.21 {TextSearchCmd procedure, skip dummy last line} {
  906.     .t search \n end
  907. } {1.15}
  908. test text-20.22 {TextSearchCmd procedure, skip dummy last line} {
  909.     .t search -back \n 1.0
  910. } {3.9}
  911. test text-20.23 {TextSearchCmd procedure, extract line contents} {
  912.     .t tag add foo 1.2
  913.     .t tag add x 1.3
  914.     .t mark set silly 1.2
  915.     .t search xyz 3.6
  916. } {1.1}
  917. test text-20.24 {TextSearchCmd procedure, stripping newlines} {
  918.     .t search the\n 1.0
  919. } {1.12}
  920. test text-20.25 {TextSearchCmd procedure, stripping newlines} {
  921.     .t search -regexp the\n 1.0
  922. } {}
  923. test text-20.26 {TextSearchCmd procedure, stripping newlines} {
  924.     .t search -regexp {the$} 1.0
  925. } {1.12}
  926. test text-20.27 {TextSearchCmd procedure, stripping newlines} {
  927.     .t search -regexp \n 1.0
  928. } {}
  929. test text-20.28 {TextSearchCmd procedure, line case conversion} {
  930.     list [.t search -nocase bar 2.18] [.t search bar 2.18]
  931. } {2.23 2.13}
  932. test text-20.29 {TextSearchCmd procedure, firstChar and lastChar} {
  933.     .t search -backwards xyz 1.6
  934. } {1.5}
  935. test text-20.30 {TextSearchCmd procedure, firstChar and lastChar} {
  936.     .t search -backwards xyz 1.5
  937. } {1.1}
  938. test text-20.31 {TextSearchCmd procedure, firstChar and lastChar} {
  939.     .t search xyz 1.5
  940. } {1.5}
  941. test text-20.32 {TextSearchCmd procedure, firstChar and lastChar} {
  942.     .t search xyz 1.6
  943. } {3.0}
  944. test text-20.33 {TextSearchCmd procedure, firstChar and lastChar} {
  945.     .t search {} 1.end
  946. } {1.15}
  947. test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} {
  948.     .t search f 1.end
  949. } {2.0}
  950. test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} {
  951.     .t search {} end
  952. } {1.0}
  953. toplevel .t2
  954. wm geometry .t2 +0+0
  955. text .t2.t -width 30 -height 10
  956. pack .t2.t
  957. .t2.t insert 1.0 "This is a line\nand this is another"
  958. .t2.t insert end "\nand this is yet another"
  959. frame .t2.f -width 20 -height 20 -bd 2 -relief raised
  960. .t2.t window create 2.5 -window .t2.f
  961. test text-20.36 {TextSearchCmd procedure, firstChar and lastChar} {
  962.     .t2.t search his 2.6
  963. } {2.6}
  964. test text-20.37 {TextSearchCmd procedure, firstChar and lastChar} {
  965.     .t2.t search this 2.6
  966. } {3.4}
  967. test text-20.38 {TextSearchCmd procedure, firstChar and lastChar} {
  968.     .t2.t search is 2.6
  969. } {2.7}
  970. test text-20.39 {TextSearchCmd procedure, firstChar and lastChar} {
  971.     .t2.t search his 2.7
  972. } {3.5}
  973. test text-20.40 {TextSearchCmd procedure, firstChar and lastChar} {
  974.     .t2.t search -backwards "his is another" 2.6
  975. } {2.6}
  976. test text-20.41 {TextSearchCmd procedure, firstChar and lastChar} {
  977.     .t2.t search -backwards "his is" 2.6
  978. } {1.1}
  979. destroy .t2
  980. test text-20.42 {TextSearchCmd procedure, firstChar and lastChar} {
  981.     .t search -backwards forw 2.5
  982. } {2.5}
  983. test text-20.43 {TextSearchCmd procedure, firstChar and lastChar} {
  984.     .t search forw 2.5
  985. } {2.5}
  986. test text-20.44 {TextSearchCmd procedure, firstChar and lastChar} {
  987.     catch {destroy .t2}
  988.     text .t2
  989.     list [.t2 search a 1.0] [.t2 search -backward a 1.0]
  990. } {{} {}}
  991. test text-20.45 {TextSearchCmd procedure, regexp match length} {
  992.     set length unchanged
  993.     list [.t search -regexp -count length x(.)(.*)z 1.1] $length
  994. } {1.1 7}
  995. test text-20.46 {TextSearchCmd procedure, regexp match length} {
  996.     set length unchanged
  997.     list [.t search -regexp -backward -count length fo* 2.5] $length
  998. } {2.0 3}
  999. test text-20.47 {TextSearchCmd procedure, checking stopIndex} {
  1000.     list [.t search bar 2.1 2.13] [.t search bar 2.1 2.14] \
  1001.         [.t search bar 2.12 2.14] [.t search bar 2.14 2.14]
  1002. } {{} 2.13 2.13 {}}
  1003. test text-20.48 {TextSearchCmd procedure, checking stopIndex} {
  1004.     list [.t search -backwards bar 2.20 2.13] \
  1005.         [.t search -backwards bar 2.20 2.14] \
  1006.         [.t search -backwards bar 2.14 2.13] \
  1007.         [.t search -backwards bar 2.13 2.13]
  1008. } {2.13 {} 2.13 {}}
  1009. test text-20.49 {TextSearchCmd procedure, embedded windows and index/count} {
  1010.     frame .t.f1 -width 20 -height 20 -relief raised -bd 2
  1011.     frame .t.f2 -width 20 -height 20 -relief raised -bd 2
  1012.     frame .t.f3 -width 20 -height 20 -relief raised -bd 2
  1013.     frame .t.f4 -width 20 -height 20 -relief raised -bd 2
  1014.     .t window create 2.10 -window .t.f3
  1015.     .t window create 2.8 -window .t.f2
  1016.     .t window create 2.8 -window .t.f1
  1017.     .t window create 2.1 -window .t.f4
  1018.     set result ""
  1019.     lappend result [.t search -count x forward 1.0] $x
  1020.     lappend result [.t search -count x wa 1.0] $x
  1021.     .t delete 2.1
  1022.     .t delete 2.8 2.10
  1023.     .t delete 2.10
  1024.     set result
  1025. } {2.6 10 2.11 2}
  1026. test text-20.50 {TextSearchCmd procedure, error setting variable} {
  1027.     catch {unset a}
  1028.     set a 44
  1029.     list [catch {.t search -count a(2) xyz 1.0} msg] $msg
  1030. } {1 {can't set "a(2)": variable isn't array}}
  1031. test text-20.51 {TextSearchCmd procedure, wrap-around} {
  1032.     .t search -backwards xyz 1.1
  1033. } {3.5}
  1034. test text-20.52 {TextSearchCmd procedure, wrap-around} {
  1035.     .t search -backwards xyz 1.1 1.0
  1036. } {}
  1037. test text-20.53 {TextSearchCmd procedure, wrap-around} {
  1038.     .t search xyz 3.6
  1039. } {1.1}
  1040. test text-20.54 {TextSearchCmd procedure, wrap-around} {
  1041.     .t search xyz 3.6 end
  1042. } {}
  1043. test text-20.55 {TextSearchCmd procedure, no match} {
  1044.     .t search non_existent 3.5
  1045. } {}
  1046. test text-20.56 {TextSearchCmd procedure, no match} {
  1047.     .t search -regexp non_existent 3.5
  1048. } {}
  1049. test text-20.57 {TextSearchCmd procedure, special cases} {
  1050.     .t search -back x 1.1
  1051. } {1.0}
  1052. test text-20.58 {TextSearchCmd procedure, special cases} {
  1053.     .t search -back x 1.0
  1054. } {3.8}
  1055. test text-20.59 {TextSearchCmd procedure, special cases} {
  1056.     .t search \n {end-2c}
  1057. } {3.9}
  1058. test text-20.60 {TextSearchCmd procedure, special cases} {
  1059.     .t search \n end
  1060. } {1.15}
  1061. test text-20.61 {TextSearchCmd procedure, special cases} {
  1062.     .t search x 1.0
  1063. } {1.0}
  1064. test text-20.62 {TextSearchCmd, freeing copy of pattern} {
  1065.     # This test doesn't return a result, but it will generate
  1066.     # a core leak if the pattern copy isn't properly freed.
  1067.  
  1068.     set p abcdefg1234567890
  1069.     set p $p$p$p$p$p$p$p$p
  1070.     set p $p$p$p$p$p
  1071.     .t search -nocase $p 1.0
  1072. } {}
  1073.  
  1074. eval destroy [winfo child .]
  1075. text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100
  1076. pack .t2
  1077. .t2 insert end "1\t2\t3\t4\t55.5"
  1078. test text-21.1 {TkTextGetTabs procedure} {
  1079.     list [catch {.t2 configure -tabs "\{{}"} msg] $msg
  1080. } {1 {unmatched open brace in list}}
  1081. test text-21.2 {TkTextGetTabs procedure} {
  1082.     list [catch {.t2 configure -tabs xyz} msg] $msg
  1083. } {1 {bad screen distance "xyz"}}
  1084. test text-21.3 {TkTextGetTabs procedure} {
  1085.     .t2 configure -tabs {100 200}
  1086.     update idletasks
  1087.     list [lindex [.t2 bbox 1.2] 0] [lindex [.t2 bbox 1.4] 0]
  1088. } {100 200}
  1089. test text-21.4 {TkTextGetTabs procedure} {
  1090.     .t2 configure -tabs {100 right 200 left 300 center 400 numeric}
  1091.     update idletasks
  1092.     list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \
  1093.         [lindex [.t2 bbox 1.4] 0] \
  1094.         [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \
  1095.         [lindex [.t2 bbox 1.10] 0]
  1096. } {100 200 300 400}
  1097. test text-21.5 {TkTextGetTabs procedure} {
  1098.     .t2 configure -tabs {105 r 205 l 305 c 405 n}
  1099.     update idletasks
  1100.     list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \
  1101.         [lindex [.t2 bbox 1.4] 0] \
  1102.         [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \
  1103.         [lindex [.t2 bbox 1.10] 0]
  1104. } {105 205 305 405}
  1105. test text-21.6 {TkTextGetTabs procedure} {
  1106.     list [catch {.t2 configure -tabs {100 left 200 lork}} msg] $msg
  1107. } {1 {bad tab alignment "lork": must be left, right, center, or numeric}}
  1108. test text-21.7 {TkTextGetTabs procedure} {
  1109.     list [catch {.t2 configure -tabs {100 !44 200 lork}} msg] $msg
  1110. } {1 {bad screen distance "!44"}}
  1111.  
  1112. eval destroy [winfo child .]
  1113. text .t
  1114. pack .t
  1115. .t insert 1.0 "One Line"
  1116. .t mark set insert 1.0
  1117.  
  1118. test text-22.1 {TextDumpCmd procedure, bad args} {
  1119.     list [catch {.t dump} msg] $msg
  1120. } {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
  1121. test text-22.2 {TextDumpCmd procedure, bad args} {
  1122.     list [catch {.t dump -all} msg] $msg
  1123. } {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
  1124. test text-22.3 {TextDumpCmd procedure, bad args} {
  1125.     list [catch {.t dump -command} msg] $msg
  1126. } {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
  1127. test text-22.4 {TextDumpCmd procedure, bad args} {
  1128.     list [catch {.t dump -bogus} msg] $msg
  1129. } {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
  1130. test text-22.5 {TextDumpCmd procedure, bad args} {
  1131.     list [catch {.t dump bogus} msg] $msg
  1132. } {1 {bad text index "bogus"}}
  1133. test text-22.6 {TextDumpCmd procedure, one index} {
  1134.     .t dump -text 1.2
  1135. } {text e 1.2}
  1136. test text-22.7 {TextDumpCmd procedure, two indices} {
  1137.     .t dump -text 1.0 1.end
  1138. } {text {One Line} 1.0}
  1139. test text-22.8 {TextDumpCmd procedure, "end" index} {
  1140.     .t dump -text 1.end end
  1141. } {text {
  1142. } 1.8}
  1143. test text-22.9 {TextDumpCmd procedure, same indices} {
  1144.     .t dump 1.5 1.5
  1145. } {}
  1146. test text-22.10 {TextDumpCmd procedure, negative range} {
  1147.     .t dump 1.5 1.0
  1148. } {}
  1149.  
  1150. .t delete 1.0 end
  1151. .t insert end "Line One\nLine Two\nLine Three\nLine Four"
  1152. .t mark set insert 1.0
  1153. .t mark set current 1.0
  1154.  
  1155. test text-22.11 {TextDumpCmd procedure, stop at begin-line} {
  1156.     .t dump -text 1.0 2.0
  1157. } {text {Line One
  1158. } 1.0}
  1159. test text-22.12 {TextDumpCmd procedure, span multiple lines} {
  1160.     .t dump -text 1.5 3.end
  1161. } {text {One
  1162. } 1.5 text {Line Two
  1163. } 2.0 text {Line Three} 3.0}
  1164.  
  1165. .t tag add x 2.0 2.end
  1166. .t tag add y 1.0 end
  1167. .t mark set m 2.4
  1168. .t mark set n 4.0
  1169. .t mark set END end
  1170. test text-22.13 {TextDumpCmd procedure, tags only} {
  1171.     .t dump -tag 2.1 2.8
  1172. } {}
  1173. test text-22.14 {TextDumpCmd procedure, tags only} {
  1174.     .t dump -tag 2.0 2.8
  1175. } {tagon x 2.0}
  1176. test text-22.15 {TextDumpCmd procedure, tags only} {
  1177.     .t dump -tag 1.0 4.end
  1178. } {tagon y 1.0 tagon x 2.0 tagoff x 2.8}
  1179. test text-22.16 {TextDumpCmd procedure, tags only} {
  1180.     .t dump -tag 1.0 end
  1181. } {tagon y 1.0 tagon x 2.0 tagoff x 2.8 tagoff y 5.0}
  1182.  
  1183. .t mark set insert 1.0
  1184. .t mark set current 1.0
  1185. test text-22.17 {TextDumpCmd procedure, marks only} {
  1186.     .t dump -mark 1.1 1.8
  1187. } {}
  1188. test text-22.18 {TextDumpCmd procedure, marks only} {
  1189.     .t dump -mark 2.0 2.8
  1190. } {mark m 2.4}
  1191. test text-22.19 {TextDumpCmd procedure, marks only} {
  1192.     .t dump -mark 1.1 4.end
  1193. } {mark m 2.4 mark n 4.0}
  1194. test text-22.20 {TextDumpCmd procedure, marks only} {
  1195.     .t dump -mark 1.0 end
  1196. } {mark current 1.0 mark insert 1.0 mark m 2.4 mark n 4.0 mark END 5.0}
  1197.  
  1198. button .hello -text Hello
  1199. .t window create 3.end -window .hello
  1200. for {set i 0} {$i < 100} {incr i} {
  1201.     .t insert end "-\n"
  1202. }
  1203. .t window create 100.0 -create { }
  1204. test text-22.21 {TextDumpCmd procedure, windows only} {
  1205.     .t dump -window 1.0 5.0
  1206. } {window .hello 3.10}
  1207. test text-22.22 {TextDumpCmd procedure, windows only} {
  1208.     .t dump -window 5.0 end
  1209. } {window {} 100.0}
  1210.  
  1211. .t delete 1.0 end
  1212. eval {.t mark unset} [.t mark names]
  1213. .t insert end "Line One\nLine Two\nLine Three\nLine Four"
  1214. .t mark set insert 1.0
  1215. .t mark set current 1.0
  1216. .t tag add x 2.0 2.end
  1217. .t mark set m 2.4
  1218. proc Append {varName key value index} {
  1219.     upvar #0 $varName x
  1220.     lappend x $key $index $value
  1221. }
  1222. test text-22.23 {TextDumpCmd procedure, command script} {
  1223.     set x {}
  1224.     .t dump -command {Append x} -all 1.0 end
  1225.     set x
  1226. } {mark 1.0 current mark 1.0 insert text 1.0 {Line One
  1227. } tagon 2.0 x text 2.0 Line mark 2.4 m text 2.4 { Two} tagoff 2.8 x text 2.8 {
  1228. } text 3.0 {Line Three
  1229. } text 4.0 {Line Four
  1230. }}
  1231. test text-22.24 {TextDumpCmd procedure, command script} {
  1232.     set x {}
  1233.     .t dump -mark -command {Append x} 1.0 end
  1234.     set x
  1235. } {mark 1.0 current mark 1.0 insert mark 2.4 m}
  1236. catch {unset x}
  1237.  
  1238. set l [interp hidden]
  1239. eval destroy [winfo children .]
  1240.  
  1241. test text-23.1 {text widget vs hidden commands} {
  1242.     catch {destroy .t}
  1243.     text .t
  1244.     interp hide {} .t
  1245.     destroy .t
  1246.     list [winfo children .] [interp hidden]
  1247. } [list {} $l]
  1248.  
  1249. eval destroy [winfo child .]
  1250. option clear
  1251.